home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE09 / FILES / NAMES2U2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-09  |  3.6 KB  |  146 lines

  1. unit Names2u2;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. type
  9.   TDataRec = packed record
  10.     { The form's edit box has its MaxLength property set to 30 }
  11.     Name: String[30];
  12.     { Only interested in the date portion of this date/time value }
  13.     DOB: TDateTime;
  14.   end;
  15.  
  16.   TDataFile = class
  17.   private
  18.     FDataFile: File;
  19.   protected
  20.     function GetCount: Longint;
  21.     function GetCurrent: Longint;
  22.     function GetRecord(Index: Longint): TDataRec;
  23.     procedure SetCurrent(RecNo: Longint);
  24.     procedure SetRecord(Index: Longint; const DataRec: TDataRec);
  25.   public
  26.     constructor Create;
  27.     destructor Destroy; override;
  28.     property Count: Longint read GetCount;
  29.     property Current: Longint
  30.       read GetCurrent write SetCurrent;
  31.     property Records[Index: Longint]: TDataRec
  32.       read GetRecord write SetRecord; default;
  33.   end;
  34.  
  35. implementation
  36.  
  37. uses
  38.   Forms, NetLock, Consts, Classes;
  39.  
  40. const
  41.   FileName = 'DataFile.Dat';
  42.  
  43. {$ifdef Ver80}
  44. function ExtractFileDir(const FileName: String): String;
  45. var
  46.   I: Integer;
  47. begin
  48.   Result := ExtractFilePath(FileName);
  49.   I := Length(Result);
  50.   if (I > 1) and (FileName[I] = '\') and (FileName[I - 1] <> ':') then
  51.     { This is compiled in Delphi 1 only, so this is fine }
  52.     Dec(Result[0]);
  53. end;
  54. {$endif}
  55.  
  56. constructor TDataFile.Create;
  57. begin
  58.   { Make current directory where EXE file is, just in case }
  59.   ChDir(ExtractFileDir(Application.ExeName));
  60.   AssignFile(FDataFile, FileName);
  61.   FileMode := fmOpenReadWrite or fmShareDenyNone;
  62.   try
  63.     { Make file if it ain't there }
  64.     if not FileExists(FileName) then
  65.       Rewrite(FDataFile);
  66.     Reset(FDataFile, SizeOf(TDataRec));
  67.   except
  68.     on E: EInOutError do
  69.     begin
  70.       { In case Rewrite succeeded but Reset failed }
  71.       if TFileRec(FDataFile).Mode = fmInOut then
  72.         CloseFile(FDataFile);
  73.       { Customise the exception and re-raise it }
  74.       E.Message := 'Failed to create or open ' + FileName;
  75.       raise;
  76.     end;
  77.   end;
  78. end;
  79.  
  80. destructor TDataFile.Destroy;
  81. begin
  82.   if TFileRec(FDataFile).Mode = fmInOut then
  83.     CloseFile(FDataFile);
  84.   inherited Destroy;
  85. end;
  86.  
  87. function TDataFile.GetCount: Longint;
  88. begin
  89.   Result := FileSize(FDataFile);
  90. end;
  91.  
  92. function TDataFile.GetCurrent: Longint;
  93. begin
  94.   Result := FilePos(FDataFile);
  95. end;
  96.  
  97. function TDataFile.GetRecord(Index: Longint): TDataRec;
  98. var
  99.   Count: Cardinal;
  100. begin
  101.   Current := Index;
  102.   BlockRead(FDataFile, Result, 1, Count);
  103.   if Count < 1 then
  104.     raise EListError.CreateRes(SListIndexError);
  105.   { Go back to the beginning of the read record }
  106.   Current := Index;
  107. end;
  108.  
  109. procedure TDataFile.SetCurrent(RecNo: Longint);
  110. begin
  111.   { Anything past EOF is considered EOF }
  112.   if RecNo > Count then
  113.     RecNo := Count;
  114.   Seek(FDataFile, RecNo);
  115. end;
  116.  
  117. procedure TDataFile.SetRecord(Index: Longint; const DataRec: TDataRec);
  118. var
  119.   X: EInOutError;
  120.   Count: Cardinal;
  121. begin
  122.   Current := Index;
  123.   if not LockFileVar(FDataFile, Current, False) then
  124.   begin
  125.     X := EInOutError.Create('Cannot lock file');
  126.     { Set up a file access denied type exception }
  127.     X.ErrorCode := 5;
  128.     raise X;
  129.   end;
  130.   try
  131.     { DataRec is passed as a const (pass by reference, but }
  132.     { not allowed to be treated/passed as a var parameter). }
  133.     { We can get around this by dereferencing its }
  134.     { address with an appropriate typecast }
  135.     BlockWrite(FDataFile, TDataRec((@DataRec)^), 1, Count);
  136.     if Count < 1 then
  137.       raise EInOutError.Create('Cannot write to file');
  138.     { Go back to the beginning of the written record }
  139.     Current := Index;
  140.   finally
  141.     LockFileVar(FDataFile, Current, True);
  142.   end;
  143. end;
  144.  
  145. end.
  146.